home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
The World of Computer Software.iso
/
tvg103_s.zip
/
STYX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-29
|
5KB
|
224 lines
{************************************************}
{ }
{ Turbo Pascal 6.0 }
{ Turbo Vision Demo }
{ Copyright (c) 1990 by Borland International }
{ }
{************************************************}
unit Styx;
{$F+,O-,X+,S-,D+,L+}
{ Graphics Styx demo }
interface
uses TvGraph, DemoCmds, Objects, App, Views, Drivers;
type
XYCord = record
XA,YA,XB,YB:integer;
end;
PStyx = ^TStyx;
TStyx = object(TView)
(* use as bit map *)
GraphWindowId:byte;
CurrentStick:byte;
Velocity:XYCord;
StyxLocations:Array[0..15] of XYCord;
constructor Init(Var Bounds:Trect);
destructor Done;virtual;
procedure Prod;
procedure Draw; virtual;
procedure GetGraphBounds(var R:GRect);
procedure GetGraphClipRect(var R:GRect);
procedure HandleEvent(var Event:TEvent); virtual;
end;
PStyxDemo = ^TStyxDemo;
TStyxDemo = object(TWindow)
constructor Init;
end;
const
AsciiTableCommandBase: Word = 910;
RStyx: TStreamRec = (
ObjType: 10090;
VmtLink: Ofs(TypeOf(TStyx)^);
Load: @TStyx.Load;
Store: @TStyx.Store
);
RStyxDemo: TStreamRec = (
ObjType: 10091;
VmtLink: Ofs(TypeOf(TStyxDemo)^);
Load: @TStyxDemo.Load;
Store: @TStyxDemo.Store
);
procedure RegisterStyx;
implementation
constructor TStyx.Init(Var Bounds:Trect);
var
R:GRect;
begin
TView.Init(Bounds);
CurrentStick:=0;
GrowMode:=gfGrowHiX+GfGrowHiY;
fillchar(StyxLocations,Sizeof(StyxLocations),#0);
(* Assume all available *)
GraphWindowId:=NextGraphId;
UseGraphId(GraphWindowId);
GetGraphBounds(R);
with Styxlocations[0] do
with R do
begin
XA:=(B.X-A.X) div 2;
YA:=(B.Y-A.Y) div 2;
XB:=(B.X-A.X) div 3;
YB:=(B.Y-A.Y) div 3;
end;
with Velocity do
begin
XA:=random(4)+1;if XA>2 then XA:=2-XA;
XA:=XA*16;
YA:=random(4)+1;if YA>2 then YA:=2-YA;
YA:=YA*16;
XB:=random(4)+1;if XB>2 then XB:=2-XB;
XB:=XB*16;
YB:=random(4)+1;if YB>2 then YB:=2-YB;
YB:=YB*16;
end;
end;
procedure TStyx.GetGraphBounds(var R:GRect);
begin
GetExtent(R);
MakeGlobal(R.A,R.A);
MakeGlobal(R.B,R.B);
TextToGraphics(R,R);
end;
procedure TStyx.GetGraphClipRect(var R:GRect);
begin
GetClipRect(R);
MakeGlobal(R.A,R.A);
MakeGlobal(R.B,R.B);
TextToGraphics(R,R);
end;
procedure TStyx.Draw;
var
Buf: TDrawBuffer;
Y: Integer;
Color: Byte;
R:TRect;
begin
GetExtent(R);
MakeGlobal(R.A,R.A);
MakeGlobal(R.B,R.B);
Color := 255;
MoveChar(Buf, Char(GraphWindowId), Color, Size.X);
for Y:=0 to Size.Y-1 do
WriteLine(0, Y, Size.X, 1, Buf);
Prod;
end;
procedure TStyx.Prod;
const
StyxColor:array[0..15] of byte =(15,11,11,9,9,9,9,1,1,1,1,1,1,1,1,0);
var
Count:byte;
Actual:byte;
R:GRect;
LS:byte;
XMax,YMax:word;
begin
UseGraphId(GraphWindowId);
LS:=CurrentStick;
CurrentStick:=(CurrentStick+1) mod 16;
GetGraphBounds(R);
XMax:=R.B.X-R.A.X-1;
YMax:=R.B.Y-R.A.Y-1;
with Styxlocations[CurrentStick] do
with R do
begin
XA:=Styxlocations[LS].XA+Velocity.XA;
if (XA<0) or (XA>XMax) then
begin
Velocity.XA:=-Velocity.XA;
if XA<0 then XA:=0 else XA:=XMax
end;
XB:=Styxlocations[LS].XB+Velocity.XB;
if (XB<0) or (XB>XMax) then
begin
Velocity.XB:=-Velocity.XB;
if XB<0 then XB:=0 else XB:=XMax
end;
YA:=Styxlocations[LS].YA+Velocity.YA;
if (YA<0) or (YA>YMax) then
begin
Velocity.YA:=-Velocity.YA;
if YA<0 then YA:=0 else YA:=YMax
end;
YB:=Styxlocations[LS].YB+Velocity.YB;
if (YB<0) or (YB>YMax) then
begin
Velocity.YB:=-Velocity.YB;
if YB<0 then YB:=0 else YB:=YMax
end;
end;
for count:=0 to 15 do
begin
Actual:=(16-Count+CurrentStick) mod 16;
with Styxlocations[Count] do
DrawLine(R.A.X+XA,R.A.Y+YA,R.A.X+XB,R.A.Y+YB,StyxColor[Actual]);
end;
end;
procedure TStyx.HandleEvent(var Event:TEvent);
var
CurrentSpot: TPoint;
begin
if (Event.What=evCommand) and (Event.Command=cmProdStyx) then
begin
Prod;
ClearEvent(Event);
end;
TView.HandleEvent(Event);
end;
destructor TStyx.Done;
begin
TView.Done;
ReleaseGraphId(GraphWindowId);
end;
constructor TStyxDemo.Init;
var
R: TRect;
Control: PVIew;
begin
R.Assign(0, 0, 34, 12);
TWindow.Init(R, 'S T Y X', wnNoNumber);
{ Flags := Flags and not (wfGrow + wfZoom);}
GetExtent(R);
R.Grow(-1,-1);
Control := New(PStyx, Init(R));
with Control^ do
Options := Options or ofFramed;
Insert(Control);
Control^.Select;
end;
procedure RegisterStyx;
begin
RegisterType(RStyx);
RegisterType(RStyxDemo);
end;
end.